home *** CD-ROM | disk | FTP | other *** search
/ Linux Cubed Series 2: Applications / Linux Cubed Series 2 - Applications.iso / editors / emacs / xemacs / xemacs-1.006 / xemacs-1 / lib / xemacs-19.13 / lisp / oobr / br-compl.el < prev    next >
Encoding:
Text File  |  1995-05-05  |  9.7 KB  |  285 lines
  1. ;;!emacs
  2. ;;
  3. ;; FILE:         br-compl.el
  4. ;; SUMMARY:      Most functions for performing completion on OO constructs.
  5. ;; USAGE:        GNU Emacs Lisp Library
  6. ;; KEYWORDS:     matching, oop, tools
  7. ;;
  8. ;; AUTHOR:       Bob Weiner
  9. ;; ORG:          Motorola Inc.
  10. ;;
  11. ;; ORIG-DATE:    27-Mar-90
  12. ;; LAST-MOD:      4-May-95 at 17:08:48 by Bob Weiner
  13. ;;
  14. ;; Copyright (C) 1990-1995  Free Software Foundation, Inc.
  15. ;; See the file BR-COPY for license information.
  16. ;;
  17. ;; This file is part of the OO-Browser.
  18. ;;
  19. ;; DESCRIPTION:  
  20. ;; DESCRIP-END.
  21.  
  22. (global-set-key "\M-\C-i" 'br-complete-symbol)
  23.  
  24. ;; ************************************************************************
  25. ;; Other required Elisp libraries
  26. ;; ************************************************************************
  27.  
  28. ;; Requires a number of functions from "br-lib.el", part of the OO-Browser
  29. ;; package.  See the code for functions called but not defined within this
  30. ;; file.
  31.  
  32. ;; ************************************************************************
  33. ;; Public functions
  34. ;; ************************************************************************
  35.  
  36. (defun br-buffer-menu ()
  37.   "Display list of buffers for current browser language in the viewer window."
  38.   (interactive)
  39.   (or (br-in-view-window-p)
  40.       (setq *br-prev-listing-window* (selected-window)))
  41.   (let ((owind (selected-window))
  42.     (ovbuf (save-window-excursion
  43.          (br-to-view-window)
  44.          (current-buffer))))
  45.     (buffer-menu 'files-only)
  46.     (narrow-to-region (point) (point-max))
  47.     (let ((buffer-read-only nil)
  48.       (buf-name))
  49.       (while (setq buf-name (br-buffer-menu-buffer-name))
  50.     (if (not (string-match br-src-file-regexp buf-name))
  51.         (delete-region (point) (progn (forward-line 1) (point)))
  52.       (forward-line 1))))
  53.     (goto-char (point-min))
  54.     (widen)
  55.     (if (looking-at "^$")    ;; No matching buffers
  56.     (progn
  57.       (switch-to-buffer ovbuf)
  58.       (select-window owind)
  59.       (beep)
  60.       (message
  61.        "(OO-Browser):  No appropriate buffers available for selection."))
  62.       (set-window-start nil 1)
  63.       (substitute-key-definition 'Buffer-menu-select 'br-buffer-menu-select
  64.                  Buffer-menu-mode-map)
  65.       (message "(OO-Browser):  Select a buffer for display."))))
  66.  
  67. (defun br-buffer-menu-buffer-name ()
  68.   "Return name of buffer on curren buffer menu line or nil.
  69. Leaves point at the beginning of the current line."
  70.   (if (= (point) (point-max))
  71.       nil
  72.     (beginning-of-line)
  73.     (forward-char Buffer-menu-buffer-column)
  74.     (let ((start (point)))
  75.       ;; End of buffer name marked by tab or two spaces.
  76.       (if (not (re-search-forward "\t\\|  "))
  77.       nil
  78.     (skip-chars-backward " \t")
  79.     (prog1
  80.         (buffer-substring start (point))
  81.       (beginning-of-line))))))
  82.  
  83. (defun br-buffer-menu-select ()
  84.   "Display buffer associated with the line that point is on."
  85.   (interactive)
  86.   (substitute-key-definition 'br-buffer-menu-select 'Buffer-menu-select 
  87.                  Buffer-menu-mode-map)
  88.   (let ((buff (Buffer-menu-buffer t))
  89.     (menu (current-buffer)))
  90.     (if buff
  91.     (progn (switch-to-buffer buff)
  92.            (or (eq menu buff)
  93.            (bury-buffer menu)))
  94.       (beep))))
  95.  
  96. (defun br-complete-entry (&optional prompt)
  97.   "Interactively completes class or feature name and returns it or nil.
  98. Optional PROMPT is initial prompt string for user."
  99.   (interactive)
  100.   (let ((default (and (br-in-browser)
  101.               (not (br-in-view-window-p))
  102.               (br-find-class-name)))
  103.     (completion-ignore-case t)
  104.     completions
  105.     element-name)
  106.     (if (not (br-class-path default)) (setq default nil))
  107.     ;; Prompt with possible completions of element-name.
  108.     (setq prompt (or prompt "Class/Element name:")
  109.       completions (append (br-class-completions)
  110.                   (br-feature-completions))
  111.       element-name
  112.       (if completions
  113.           (completing-read
  114.         (format "%s (default %s) " prompt (or default "<None>"))
  115.         completions nil 'must-match)
  116.         (read-string
  117.           (format "%s (default %s) " prompt (or default "<None>")))))
  118.     (if (equal element-name "") (setq element-name default))
  119.     element-name))
  120.  
  121. (defun br-complete-symbol ()
  122.   "Complete symbol preceding point."
  123.   (interactive)
  124.   (cond ((and (fboundp 'br-lang-mode)
  125.           (eq major-mode (symbol-function 'br-lang-mode)))
  126.      (br-complete-type))
  127.     (t
  128.      (lisp-complete-symbol))))
  129.  
  130. (defun br-complete-class-name (&optional must-match prompt)
  131.   "Interactively completes class name if possible, and returns class name.
  132. Optional MUST-MATCH means class name must match a completion table entry.
  133. Optional PROMPT is intial prompt string for user."
  134.   (interactive)
  135.   (let ((default (br-find-class-name))
  136.     (completion-ignore-case t)
  137.     completions
  138.     class-name)
  139.     ;; Prompt with possible completions of class-name.
  140.     (setq prompt (or prompt "Class name:")
  141.       completions (br-class-completions)
  142.       class-name
  143.       (if completions
  144.           (completing-read
  145.         (format "%s (default %s) " prompt default)
  146.         completions nil must-match)
  147.         (read-string
  148.           (format "%s (default %s) " prompt default))))
  149.     (if (equal class-name "") default class-name)))
  150.  
  151. (defun br-lisp-mode-p ()
  152.   (or (eq major-mode 'lisp-mode)
  153.       (eq major-mode 'emacs-lisp-mode)
  154.       (eq major-mode 'scheme-mode)
  155.       (eq major-mode 'lisp-interaction-mode)))
  156.  
  157. (defun br-complete-type ()
  158.   "Perform in-buffer completion of a type or element identifier before point.
  159. That symbol is compared against current Environment entries and any needed
  160. characters are inserted."
  161.   (interactive)
  162.   (let* ((completion-ignore-case nil)
  163.      (end (point))
  164.      (beg (save-excursion
  165.         (if (br-lisp-mode-p)
  166.             nil
  167.           (skip-chars-backward "^()")
  168.           (if (eq (preceding-char) ?\()
  169.               (skip-chars-backward " \t\(")
  170.             (goto-char end))
  171.           )
  172.         (skip-chars-backward (concat br-identifier-chars ":"))
  173.         (point)))
  174.      (pattern (br-set-case (buffer-substring beg end)))
  175.      (type-p)
  176.      (completion-alist (if (string-match br-feature-signature-regexp
  177.                          pattern)
  178.                    (br-feature-completions)
  179.                  (setq type-p t)
  180.                  (br-class-completions)))
  181.      (completion (try-completion pattern completion-alist)))
  182.     (cond ((eq completion t))
  183.       ((null completion)
  184.        (message "Can't find completion for '%s'" pattern)
  185.        (ding))
  186.       ((not (string-equal pattern completion))
  187.        (delete-region beg end)
  188.        (insert (if type-p
  189.                (br-set-case-type completion)
  190.              completion)))
  191.       (t
  192.         (message "Making completion list...")
  193.         (let ((list (sort (all-completions pattern completion-alist)
  194.                   'string-lessp)))
  195.           (let (new)
  196.         (while list
  197.           (setq new (cons (car list) new)
  198.             list (cdr list)))
  199.         (setq list (nreverse new)))
  200.           (with-output-to-temp-buffer "*Completions*"
  201.         (display-completion-list list)))
  202.         (message "Making completion list...%s" "done")))))
  203.  
  204. ;; Derived from saveconf.el.
  205. (defun br-window-list ()
  206.   "Returns a list of Lisp window objects for all Emacs windows.
  207. Do not count the minibuffer window even if it is active."
  208.   (let* ((first-window (next-window (previous-window (selected-window))))
  209.      (windows (cons first-window nil))
  210.      (current-cons windows)
  211.      (w (next-window first-window)))
  212.     (while (not (eq w first-window))
  213.       (setq current-cons (setcdr current-cons (cons w nil)))
  214.       (setq w (next-window w)))
  215.     windows))
  216.  
  217. ;; ************************************************************************
  218. ;; Private functions
  219. ;; ************************************************************************
  220.  
  221. (defun br-all-classes (&optional htable-type duplicates-flag)
  222.   "Return list of class names in Environment or optional HTABLE-TYPE.
  223. HTABLE-TYPE may be \"sys\" or \"lib\" or an actual hash table.
  224. List is not sorted unless optional DUPLICATES-FLAG is non-nil, which means cons
  225. the the sorted list of duplicate classes onto the front of the unique class
  226. names list."
  227.   (let ((classes
  228.      (apply 'append
  229.         (hash-map
  230.          (function (lambda (val-key-cons)
  231.                  ;; Copy so that hash-table values are not
  232.                  ;; disturbed.
  233.                  (copy-sequence (car val-key-cons))))
  234.          (cond ((and (stringp htable-type)
  235.                  (not (string-equal htable-type "")))
  236.             (br-get-htable (concat htable-type "-paths")))
  237.                ((hashp htable-type) htable-type)
  238.                (t (br-get-paths-htable)))))))
  239.     (if duplicates-flag
  240.     (br-duplicate-and-unique-strings (sort classes 'string-lessp))
  241.       classes)))
  242.  
  243. (defun br-class-completions ()
  244.   "Return alist of elements whose cars are all class names in lookup table."
  245.   (mapcar (function (lambda (elt) (cons elt nil)))
  246.       (br-class-list-filter (sort (br-all-classes) 'string-lessp))))
  247.  
  248. (defun br-find-class-name (&optional keep-indent)
  249.   "Return class name that point is within in a listing buffer, else nil.
  250. Optional KEEP-INDENT non-nil means keep indentation preceding class name."
  251.   (if (= (point) (point-max)) (skip-chars-backward " \t\n"))
  252.   (save-excursion
  253.     (if (looking-at (concat "[ \t]*" br-feature-type-regexp "?[ \t]+"))
  254.     (goto-char (match-end 0)))
  255.     (let ((objc (string-equal br-lang-prefix "objc-"))
  256.       (class))
  257.       (if objc
  258.       ;; Include [] characters for default classes, <> for Objective-C
  259.       ;; protocols and () for Objective-C class categories.
  260.       (skip-chars-backward (concat "\]\[()<>" br-identifier-chars))
  261.     (skip-chars-backward (concat "\]\[" br-identifier-chars)))
  262.       (if (or (and objc
  263.            (or
  264.             ;; Objective-C protocol
  265.             (looking-at (concat "<" br-identifier ">"))
  266.             ;; Objective-C class(category)
  267.             (looking-at (concat br-identifier "(" br-identifier ")"))
  268.             ;; Objective-C class(category)
  269.             (if (looking-at
  270.              (concat "\\((" br-identifier ")\\)" br-identifier))
  271.             (setq class (concat (buffer-substring (match-end 1) 
  272.                                   (match-end 0))
  273.                         (buffer-substring
  274.                          (match-beginning 1)
  275.                          (match-end 1)))))))
  276.           (looking-at br-identifier)
  277.           ;; default class
  278.           (looking-at (concat "\\[" br-identifier "\\]")))
  279.       (progn (if keep-indent (beginning-of-line))
  280.          (br-set-case (or class
  281.                   (buffer-substring (point)
  282.                             (match-end 0)))))))))
  283.  
  284. (provide 'br-compl)
  285.